## speed dist
## Min. : 4.0 Min. : 2.00
## 1st Qu.:12.0 1st Qu.: 26.00
## Median :15.0 Median : 36.00
## Mean :15.4 Mean : 42.98
## 3rd Qu.:19.0 3rd Qu.: 56.00
## Max. :25.0 Max. :120.00
## (Intercept) speed
## -17.579095 3.932409
上記の結果から、今回の回帰係数は、切片が-17.5790949で、傾きが3.9324088であることがわかる。これを線形の式に直すと、以下の通りになる。
\[ dist = -17.5790949 + 3.9324088 \times speed \]
# define the dataset `cars_result`
cars_result <- data.frame(cars,
resid = resid(cars.lm), # residuals of the linear model
resid_abs = abs(resid(cars.lm)) # absolute value of the residuals
)# order `cars_result`
head(cars_result[sort(cars_result$resid_abs, decreasing = T, index = T)[[2]],], n = 10)## speed dist resid resid_abs
## 49 24 120 43.20128 43.20128
## 23 14 80 42.52537 42.52537
## 35 18 84 30.79574 30.79574
## 39 20 32 -29.06908 29.06908
## 34 18 76 22.79574 22.79574
## 22 14 60 22.52537 22.52537
## 24 15 20 -21.40704 21.40704
## 36 19 36 -21.13667 21.13667
## 45 23 54 -18.86631 18.86631
## 29 17 32 -17.27185 17.27185
国土交通省の資料「安全な車に乗ろう」 国土交通省の資料「安全な車に乗ろう」なども参考にし,安全な自動車を設計するために必要な実験や調査を考えたとき,対象となる変量はどのようなものが考えられるだろうか。そして,そこにはどのような因果関係があるか考察しよう。
対象となる変数
仮説
実験 ABSを装備した自動車のと、通常のブレーキを装備した自動車のグループを用意し、同じ条件下で、あるスピードから停止するのにかかる時間を計測する。その後、スピードを説明変数とし、停止距離を目的変数とした回帰モデルにおけるそれぞれの傾きを比較し、ABSが装備されているか否かで停止距離に影響があるのかを検証する。
回帰モデル ABSを装備した自動車をAグループとし、通常のブレーキを装備した自動車をBグループとする。
\[ dist_A = \beta_{1_A} + \beta_{2_A} speed_A + u_A \]
\[ dist_B = \beta_{1_B} + \beta_{2_B} speed_B + u_B \]
上記の回帰モデルを走らせた後、\(\beta_{2_A}\)と\(\beta_{2_B}\)を比べ、違いがあるのかを検証する。
コード等をwordに貼って、ファイルを提出する
## X name year selling_price km_driven fuel seller_type
## 1 1 Maruti 800 AC 2007 60000 70000 Petrol Individual
## 2 2 Maruti Wagon R LXI Minor 2007 135000 50000 Petrol Individual
## 3 3 Hyundai Verna 1.6 SX 2012 600000 100000 Diesel Individual
## 4 4 Datsun RediGO T Option 2017 250000 46000 Petrol Individual
## 5 5 Honda Amaze VX i-DTEC 2014 450000 141000 Diesel Individual
## 6 6 Maruti Alto LX BSIII 2007 140000 125000 Petrol Individual
## transmission owner
## 1 Manual First Owner
## 2 Manual First Owner
## 3 Manual First Owner
## 4 Manual First Owner
## 5 Manual Second Owner
## 6 Manual First Owner
## X name year selling_price
## Min. : 1 Length:4340 Min. :1992 Min. : 20000
## 1st Qu.:1086 Class :character 1st Qu.:2011 1st Qu.: 208750
## Median :2170 Mode :character Median :2014 Median : 350000
## Mean :2170 Mean :2013 Mean : 504127
## 3rd Qu.:3255 3rd Qu.:2016 3rd Qu.: 600000
## Max. :4340 Max. :2020 Max. :8900000
## km_driven fuel seller_type transmission
## Min. : 1 Length:4340 Length:4340 Length:4340
## 1st Qu.: 35000 Class :character Class :character Class :character
## Median : 60000 Mode :character Mode :character Mode :character
## Mean : 66216
## 3rd Qu.: 90000
## Max. :806599
## owner
## Length:4340
## Class :character
## Mode :character
##
##
##
## $selling_price
## [1] 334718640088
##
## $km_driven
## [1] 2175672269
## (Intercept) km_driven
## 662055.007854 -2.385046
上記の結果から、今回の回帰係数は、切片が6.620550110^{5}で、傾きが-2.3850463であることがわかる。これを線形の式に直すと、以下の通りになる。
\[ selling_price = 6.6205501\times 10^{5} + -2.3850463 \times km_driven \]
plot(data$km_driven, data$selling_price,
xlab = "Driven Distan (km)",
ylab = "Selling Prise ($)"
)
abline(data.lm, col = "darkred", lwd = 2)# define the dataset `data_result`
data_result <- data.frame(data,
resid = resid(data.lm), # residuals of the linear model
resid_abs = abs(resid(data.lm)) # absolute value of the residuals
)# order `data_result`
head(data_result[sort(data_result$resid_abs, decreasing = T, index = T)[[2]],], n = 10)## X name year selling_price
## 3873 3873 Audi RS7 2015-2019 Sportback Performance 2016 8900000
## 90 90 Mercedes-Benz S-Class S 350d Connoisseurs Edition 2017 8150000
## 3970 3970 Mercedes-Benz GLS 2016-2020 350d 4MATIC 2016 5500000
## 556 556 BMW X5 xDrive 30d xLine 2019 4950000
## 575 575 BMW X5 xDrive 30d xLine 2019 4950000
## 594 594 BMW X5 xDrive 30d xLine 2019 4950000
## 613 613 BMW X5 xDrive 30d xLine 2019 4950000
## 901 901 BMW X5 xDrive 30d xLine 2019 4950000
## 920 920 BMW X5 xDrive 30d xLine 2019 4950000
## 1024 1024 BMW X5 xDrive 30d xLine 2019 4950000
## km_driven fuel seller_type transmission owner resid resid_abs
## 3873 13000 Petrol Dealer Automatic First Owner 8268951 8268951
## 90 6500 Diesel Dealer Automatic First Owner 7503448 7503448
## 3970 77350 Diesel Dealer Automatic First Owner 5022428 5022428
## 556 30000 Diesel Dealer Automatic First Owner 4359496 4359496
## 575 30000 Diesel Dealer Automatic First Owner 4359496 4359496
## 594 30000 Diesel Dealer Automatic First Owner 4359496 4359496
## 613 30000 Diesel Dealer Automatic First Owner 4359496 4359496
## 901 30000 Diesel Dealer Automatic First Owner 4359496 4359496
## 920 30000 Diesel Dealer Automatic First Owner 4359496 4359496
## 1024 30000 Diesel Dealer Automatic First Owner 4359496 4359496
仮説:中古車ののデータから、走行距離が売却価格に対して負の影響をもつ。
モデルの説明
結果 $ sellingprice = 662055.007854 + -2.385046 kmdriven$
うまくいかなかった。残渣を見ればわかる。
残渣(residuals)は、実際の値と予測値の差分で計算される。
以下の図だと、予測値の青の線と実際の値である赤の線の間が残差である。
# load packages
library(tidyverse)
library(modelr)
library(scales)
library(plotly)
# define the data for visualization
data_plot <- data %>%
add_predictions(data.lm) %>%
add_residuals(data.lm) %>%
pivot_longer(cols = c(selling_price, pred, resid), names_to = "vars", values_to = "value")
# raw v.s. expected value
data_plot %>%
filter(vars != "resid") %>%
ggplot(aes(km_driven, value, lable = name, color = vars)) +
geom_point() +
geom_line() +
scale_x_continuous(labels = comma) +
scale_y_continuous(labels = comma) +
labs(title = "The scatter plot of the predicted value",
x = "Driven distance (km)",
y = "Selling Price",
color = "Name") +
theme_minimal()実際の値であるスピードの変化によって生じる残差の値を、グラフ化したのが以下の図になる。
library(ggrepel)
# residual
g1 <-
data_plot %>%
filter(vars == "resid") %>%
ggplot(aes(km_driven, value, label = name)) +
geom_hline(yintercept = 0, colour = "black", linetype = "dashed") +
geom_point() +
geom_line() +
# geom_label_repel(nudge_x = TRUE, nudge_y = TRUE, check_overlap = TRUE) +
labs(title = "The scatter plot of the residual",
x = "Driven Distance (km)",
y = "Residuals") +
theme_minimal()
ggplotly(g1)